home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 2 / Amiga Tools 2.iso / tools / jade / src / lisp.h < prev    next >
C/C++ Source or Header  |  1995-03-09  |  12KB  |  409 lines
  1. /* lisp.h -- Data structures/objects for Lisp
  2.    Copyright (C) 1993, 1994 John Harper <jsh@ukc.ac.uk>
  3.  
  4.    This file is part of Jade.
  5.  
  6.    Jade is free software; you can redistribute it and/or modify it
  7.    under the terms of the GNU General Public License as published by
  8.    the Free Software Foundation; either version 2, or (at your option)
  9.    any later version.
  10.  
  11.    Jade is distributed in the hope that it will be useful, but
  12.    WITHOUT ANY WARRANTY; without even the implied warranty of
  13.    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14.    GNU General Public License for more details.
  15.  
  16.    You should have received a copy of the GNU General Public License
  17.    along with Jade; see the file COPYING.  If not, write to
  18.    the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20. #ifndef _LISP_H
  21. #define _LISP_H
  22.  
  23. #ifndef _VALUE_H
  24. # include "value.h"
  25. #endif
  26.  
  27. /*
  28.  * These numbers weren't just plucked from the air, they make the blocks
  29.  * of objects fit as close as possible into powers of 2 sized blocks.
  30.  */
  31. #define CONSBLK_SIZE    682
  32. #define SYMBOLBLK_SIZE    170
  33. #define NUMBERBLK_SIZE    127
  34. #define LPOSBLK_SIZE    170
  35.  
  36. #define OBSIZE        509
  37.  
  38. enum ValueType
  39. {
  40.     /* Static strings are C string constants, use the macro MKSTR to make
  41.        them from a normal string constant.  */
  42.     V_StaticString = 0,
  43.     V_DynamicString,
  44.     V_Number,
  45. #define V_Char V_Number
  46.     V_Cons,
  47.     V_Vector,
  48.     V_Symbol,
  49.     V_Mark,
  50.     V_Pos,
  51.     /* SUBR with one argument, this arg is new value of variable to set the
  52.        var, or NULL to make it return the variable's value.  */
  53.     V_Var,
  54.     V_Subr0,
  55.     V_Subr1,
  56.     V_Subr2,
  57.     V_Subr3,
  58.     V_Subr4,
  59.     V_Subr5,
  60.     V_SubrN,
  61.     V_SF,
  62.     V_Buffer,
  63. #define V_TX V_Buffer
  64.     V_Window,
  65.     V_File,
  66.     V_Process,
  67.     V_GlyphTable,
  68.     V_Void
  69. };
  70.  
  71. #define VAL(x)        ((VALUE)(x))
  72. #define VPTR(v)        (v)
  73. #define VSTRING(v)    ((String *)(v))
  74. #define VSTR(v)        (&VSTRING(v)->str_Mem[1])
  75. #define VNUMBER(v)    ((Number *)(v))
  76. #define VNUM(v)        (VNUMBER(v)->num_Data.number)
  77. #define VCHAR(v)    VNUM(v)
  78. #define VCONS(v)    ((Cons *)(v))
  79. #define VCAR(v)        (VCONS(v)->cn_Car)
  80. #define VCDR(v)        (VCONS(v)->cn_Cdr)
  81. #define VVECT(v)    ((Vector *)(v))
  82. #define VVECTI(v,i)    (VVECT(v)->vc_Array[(i)])
  83. #define VSYM(v)        ((Symbol *)(v))
  84. #define VMARK(v)    ((Mark *)(v))
  85. #define VLPOS(v)    ((LPos *)(v))
  86. #define VPOS(v)        (VLPOS(v)->lp_Data.pos)
  87. #define VXSUBR(v)    ((XSubr *)(v))
  88. #define VSUBR(v)    ((Subr *)(v))
  89. #define VSUBR0FUN(v)    (VSUBR(v)->subr_Fun.fun0)
  90. #define VSUBR1FUN(v)    (VSUBR(v)->subr_Fun.fun1)
  91. #define VSUBR2FUN(v)    (VSUBR(v)->subr_Fun.fun2)
  92. #define VSUBR3FUN(v)    (VSUBR(v)->subr_Fun.fun3)
  93. #define VSUBR4FUN(v)    (VSUBR(v)->subr_Fun.fun4)
  94. #define VSUBR5FUN(v)    (VSUBR(v)->subr_Fun.fun5)
  95. #define VSUBRNFUN(v)    (VSUBR(v)->subr_Fun.fun1)
  96. #define VSFFUN(v)    (VSUBR(v)->subr_Fun.fun1)
  97. #define VVARFUN(v)    (VSUBR(v)->subr_Fun.fun1)
  98. #define VTX(v)        ((TX *)(v))
  99. #define VBUFFER(v)    VTX(v)
  100. #define VFILE(v)    ((LFile *)(v))
  101. #define VPROC(v)    ((struct Proc *)(v))
  102. #define VWIN(v)        ((VW *)(v))
  103. #define VGLYPHTAB(v)    ((GlyphTable *)(v))
  104.  
  105. #define VTYPE(v)    ((v)->type)
  106. #define VTYPEP(v,t)    (VTYPE(v) == (t))
  107. #define NILP(v)        ((v) == sym_nil)
  108. #define STRINGP(v)    (VTYPEP(v, V_StaticString) || VTYPEP(v, V_DynamicString))
  109. #define NUMBERP(v)    VTYPEP(v, V_Number)
  110. #define CHARP(v)    NUMBERP(v)
  111. #define CONSP(v)    VTYPEP(v, V_Cons)
  112. #define VECTORP(v)    VTYPEP(v, V_Vector)
  113. #define SYMBOLP(v)    VTYPEP(v, V_Symbol)
  114. #define BUFFERP(v)    VTYPEP(v, V_Buffer)
  115. #define POSP(v)        VTYPEP(v, V_Pos)
  116. #define MARKP(v)    VTYPEP(v, V_Mark)
  117. #define FILEP(v)    VTYPEP(v, V_File)
  118. #define PROCESSP(v)    VTYPEP(v, V_Process)
  119. #define WINDOWP(v)    (VTYPEP(v, V_Window) && VWIN(v)->vw_Window)
  120. #define GLYPHTABP(v)    VTYPEP(v, V_GlyphTable)
  121. #define VOIDP(v)    VTYPEP(v, V_Void)
  122.  
  123. #define GC_MARK_BIT    0x80
  124. #define GC_MARK(v)    (VTYPE(v) & GC_MARK_BIT)
  125. #define GC_MARKEDP(v)    (GC_MARK(v) != 0)
  126. #define GC_SET(v)    (VTYPE(v) |= GC_MARK_BIT)
  127. #define GC_CLR(v)    (VTYPE(v) &= ~GC_MARK_BIT)
  128. #define MARKVAL(v)    do { if((v) && !GC_MARKEDP(v)) mark_value(v); } while(0)
  129.  
  130.  
  131. typedef struct ValClass {
  132.     /* compares two values, rc is similar to strcmp() */
  133.     int      (*vc_Cmp)(VALUE val1, VALUE val2);
  134.     /* prints a textual representation of the object, not necessarily in 
  135.        a read'able format */
  136.     void  (*vc_Princ)(VALUE stream, VALUE obj);
  137.     /* prints a textual representation of the object, if possible in
  138.        a read'able format */
  139.     void  (*vc_Print)(VALUE stream, VALUE obj);
  140.     /* this is the name of the type */
  141.     VALUE   vc_Name;
  142. } ValClass;
  143.  
  144. /* The following is an array of VALCLASS structs, the array index corresponds
  145.    to the VTF_* numbers  */
  146. extern ValClass ValueClasses[];
  147.  
  148. /* These are also defined as functions (lower-case'd names)...  */
  149. #define VALUE_CMP(v1,v2) ValueClasses[VTYPE(v1)].vc_Cmp(v1,v2)
  150. #define PRINC_VAL(s,v)    ValueClasses[VTYPE(v)].vc_Princ(s,v)
  151. #define PRINT_VAL(s,v)    ValueClasses[VTYPE(v)].vc_Print(s,v)
  152.  
  153. /* ...except these which aren't.  */
  154. #define VALNAME(v)    (ValueClasses[VTYPE(v)].vc_Name)
  155.  
  156.  
  157. /* String data types. the `String' type is what a VALUE points to, if
  158.    the string is dynamic it gets a length field in the word before the
  159.    String struct proper.  */
  160. typedef struct {
  161.     /* str_Mem[0] is type, str_Mem[1->N] is data. */
  162.     u_char        str_Mem[1];
  163. } String;
  164.  
  165. typedef struct {
  166.     int            ds_Length;
  167.     u_char        ds_Mem[1];
  168. } DynamicString;
  169. #define DSTR_SIZE(s) (sizeof(int) + 1 + (s))
  170.  
  171. /* Get the beginning of a DynamicString from a String.  */
  172. #define DSTRING_HDR(s) ((DynamicString *)(((char *)(s)) - sizeof(int)))
  173.  
  174. /* Make a static string from a normal C string constant, ie,
  175.    MKSTR("foo") -> "\0foo"  */
  176. #define MKSTR(s) (VAL(("\0" s)))
  177.  
  178. /* Get the beginning of the String struct from a (char *)  */
  179. #define STRING_HDR(s) ((String *)(((char *)(s))-1))
  180.  
  181. /* Find the length of this String. */
  182. #define STRING_LEN(s) \
  183.  (VTYPEP(s, V_DynamicString) ? (DSTRING_HDR(s)->ds_Length) : strlen(VSTR(s)))
  184.  
  185. /* True if this string may be written to; generally V_StaticString types
  186.    are made from C string-constants and usually in read-only storage. */
  187. #define STRING_WRITEABLE_P(s) (!VTYPEP(s, V_StaticString))
  188.  
  189.     
  190. /* Number type. Generally a 32-bit signed integer.  */
  191. typedef struct _Number {
  192.     u_char        num_Type;
  193.     union {
  194.     long        number;
  195.     struct _Number *next;
  196.     }            num_Data;
  197. } Number;
  198.  
  199. typedef struct _NumberBlk {
  200.     struct _NumberBlk *nb_Next;
  201.     Number        nb_Numbers[NUMBERBLK_SIZE];
  202. } NumberBlk;
  203.  
  204.  
  205. /* Cons-cell, a pair of VALUEs, used amongst other things to construct
  206.    singly-linked lists (chained through the cdr, last pointer is nil).  */
  207. typedef struct {
  208.     u_char        cn_Type;
  209.     VALUE        cn_Car;
  210.     VALUE        cn_Cdr;
  211. } Cons;
  212.  
  213. typedef struct _ConsBlk {
  214.     struct _ConsBlk *cb_Next;
  215.     Cons        cb_Cons[CONSBLK_SIZE];
  216. } ConsBlk;
  217.  
  218.  
  219. /* Vector of VALUEs.  */
  220. typedef struct _Vector {
  221.     u_char        vc_Type;
  222.     struct _Vector *vc_Next;
  223.     int            vc_Size;
  224.     VALUE        vc_Array[0];
  225. } Vector;
  226. #define VECT_SIZE(s) ((sizeof(VALUE) * (s)) + sizeof(Vector))
  227.  
  228.  
  229. /* Symbol object, each symbol has 4 basic attributes, a name, its value
  230.    as a variable, its value as a function and a property-list.
  231.    Symbols are generally stored in hash tables (obarray) with collisions
  232.    chained from the `sym_Next' field.  */
  233. typedef struct _Symbol {
  234.     u_char    sym_Type;
  235.     u_char    sym_Flags;
  236.     VALUE    sym_Next;    /* next symbol in obarray bucket */
  237.     VALUE    sym_Name;
  238.     VALUE    sym_Value;
  239.     VALUE    sym_Function;
  240.     VALUE    sym_PropList;
  241. } Symbol;
  242.  
  243. #define SF_CONSTANT    1
  244. /* Means that the symbol's value may be in the buffer-local storage, if so
  245.    then that occurrence takes precedence. */
  246. #define SF_BUFFER_LOCAL 2
  247. /* This means that setting the value of the symbol always sets the
  248.    buffer-local value, even if one doesn't already exist.  */
  249. #define SF_SET_BUFFER_LOCAL 4
  250. #define SF_DEBUG    8    /* Break on next lisp form. */
  251.  
  252. typedef struct _SymbolBlk {
  253.     struct _SymbolBlk *sb_Next;
  254.     Symbol       sb_Symbols[SYMBOLBLK_SIZE];
  255. } SymbolBlk;
  256.  
  257.  
  258. /* Lisp version of the POS structure. */
  259. typedef union _LPos {
  260.     struct {
  261.     u_char        type;
  262.     struct POS    pos;
  263.     }            lp_Data;
  264.     union _LPos       *lp_Next;
  265. } LPos;
  266.  
  267. typedef struct _LPosBlk {
  268.     struct _LPosBlk *lb_Next;
  269.     LPos        lb_Pos[LPOSBLK_SIZE];
  270. } LPosBlk;
  271.  
  272.  
  273. /* A file object.  */
  274. typedef struct _LFile {
  275.     u_char        lf_Type;
  276.     u_char        lf_Flags;
  277.     struct _LFile  *lf_Next;
  278.     VALUE        lf_Name;
  279.     FILE       *lf_File;
  280. } LFile;
  281. #define LFF_DONT_CLOSE 1
  282.  
  283.  
  284. /* C subroutine, can take from zero to five arguments.  */
  285. typedef struct {
  286.     u_char        subr_Type;
  287.     union {
  288.     VALUE          (*fun0)(void);
  289.     VALUE          (*fun1)(VALUE);
  290.     VALUE          (*fun2)(VALUE, VALUE);
  291.     VALUE          (*fun3)(VALUE, VALUE, VALUE);
  292.     VALUE          (*fun4)(VALUE, VALUE, VALUE, VALUE);
  293.     VALUE          (*fun5)(VALUE, VALUE, VALUE, VALUE, VALUE);
  294.     }            subr_Fun;
  295.     VALUE        subr_Name;
  296.     int            subr_DocIndex;
  297.     VALUE        subr_IntSpec;
  298. } Subr;
  299.  
  300. typedef struct {
  301.     u_char        subr_Type;
  302.     void       *subr_Fun;
  303.     VALUE        subr_Name;
  304.     int            subr_DocIndex;
  305.     VALUE        subr_IntSpec;
  306. } XSubr;
  307.  
  308.  
  309. #define LIST_1(v1)           cmd_cons(v1, sym_nil)
  310. #define LIST_2(v1,v2)           cmd_cons(v1, LIST_1(v2))
  311. #define LIST_3(v1,v2,v3)       cmd_cons(v1, LIST_2(v2, v3))
  312. #define LIST_4(v1,v2,v3,v4)    cmd_cons(v1, LIST_3(v2, v3, v4))
  313. #define LIST_5(v1,v2,v3,v4,v5) cmd_cons(v1, LIST_4(v2, v3, v4, v5))
  314.  
  315.  
  316. /* Keeps a backtrace of all lisp functions called. NOT primitives. */
  317. struct LispCall {
  318.     struct LispCall *lc_Next;
  319.     VALUE        lc_Fun;
  320.     VALUE        lc_Args;
  321.     /* t if `lc_Args' is list of *evalled* arguments.  */
  322.     VALUE           lc_ArgsEvalledP;
  323. };
  324.  
  325.  
  326. /* A stack of these providing additional entry points for the mark phase of
  327.    garbage collection.  */
  328. typedef struct _GCVAL {
  329.     VALUE       *gcv_Value;
  330.     struct _GCVAL  *gcv_Next;
  331. } GCVAL;
  332.  
  333. typedef struct _GCVALN {
  334.     VALUE       *gcv_First;
  335.     int            gcv_N;
  336.     struct _GCVALN *gcv_Next;
  337. } GCVALN;
  338.  
  339. #define POPGC (gcv_stack = gcv_stack->gcv_Next)
  340. #define PUSHGC(gcv, val)            \
  341.     do {                    \
  342.     (gcv).gcv_Value = &(val);        \
  343.     (gcv).gcv_Next = gcv_stack;        \
  344.     gcv_stack = &(gcv);            \
  345.     } while(0)
  346.  
  347. #define POPGCN (gcvn_stack = gcvn_stack->gcv_Next)
  348. #define PUSHGCN(gcv, valp, n)            \
  349.     do {                    \
  350.     (gcv).gcv_First = (valp);        \
  351.     (gcv).gcv_N = (n);            \
  352.     (gcv).gcv_Next = gcvn_stack;        \
  353.     gcvn_stack = &(gcv);            \
  354.     } while(0)
  355.  
  356.  
  357. /* Macros for defining functions and their SUBR structures. */
  358. #define DEFUN(name,fsym,ssym,args,type,docindex)        \
  359.     XSubr ssym = { type, fsym, MKSTR(name), docindex, NULL };    \
  360.     VALUE fsym args
  361.  
  362. /* Same as above but with an extra arg -- an interactive-spec string. */
  363. #define DEFUN_INT(name,fsym,ssym,args,type,docindex,interactive)        \
  364.     XSubr ssym = { type, fsym, MKSTR(name), docindex, MKSTR(interactive) }; \
  365.     VALUE fsym args
  366.     
  367. #define ADD_SUBR(subr) add_subr(&subr)
  368. #define ADD_CONST_NUM(name,num) add_const_num(MKSTR(name), num)
  369. #define INTERN(sym,name) intern_static(&sym, MKSTR(name))
  370. #define DOC_VAR(sym,docIndex) \
  371.     cmd_put(sym, sym_variable_documentation, make_number(docIndex))
  372.  
  373.  
  374. /* Macros for ensuring an object is of a certain type
  375.    ie, to ensure first arg `foo' is a string,
  376.      DECLARE1(foo, STRINGP);  */
  377.  
  378. #define DECLARE(n,x,t) \
  379.     do { \
  380.     if(! t(x)) \
  381.     { \
  382.         signal_arg_error(x, n); \
  383.         return(NULL); \
  384.     } \
  385.     } while(0)
  386.  
  387. #define DECLARE1(x,t)        DECLARE(1,x,t)
  388. #define DECLARE2(x,t)        DECLARE(2,x,t)
  389. #define DECLARE3(x,t)        DECLARE(3,x,t)
  390. #define DECLARE4(x,t)        DECLARE(4,x,t)
  391. #define DECLARE5(x,t)        DECLARE(5,x,t)
  392.  
  393. #define ARG1    (find_member_by_index(args, 1))
  394. #define ARG2    (find_member_by_index(args, 2))
  395. #define ARG3    (find_member_by_index(args, 3))
  396. #define ARG4    (find_member_by_index(args, 4))
  397. #define ARG(n)    (find_member_by_index(args, n))
  398.  
  399.  
  400. /* Macros for interrupt handling */
  401.  
  402. #ifndef TEST_INT
  403. # define TEST_INT do { ; } while(0)
  404. #endif
  405.  
  406. #define INT_P (throw_value != NULL)
  407.  
  408. #endif /* _LISP_H */
  409.